home *** CD-ROM | disk | FTP | other *** search
- /*
- @B@LLabel Generator.pprx@b Copyright Gold Disk Inc., February, 1992
- This Genie will read one of several Avery Label databases contained in the current directory and allow the user to create a variety of labels.
- */
- parse arg sourcedir
- cr = '0a'x
- address command
- call SafeEndEdit.rexx()
- call ppm_AutoUpdate(0)
- units = getclip(ppgenie_units)
- call ppm_SetUnits(1)
-
- labels = ''
- counter = 0
-
- address command
- list = getdirlist.rexx(sourcedir, ".db")
- if list = '' then exit_msg("Unable to find label data:ase. Please reinstall!")
-
- selection = ppm_SelectFromList("Select Type of label..", 35, 5, 0, list)
- if selection = '' then exit_msg()
-
- filename = sourcedir"/"selection".db"
-
- if ~open(file, filename, "r") then exit_msg("An error has occured reading database")
-
- call ppm_ShowStatus("Reading label database..")
-
- line = readln(file)
-
- if pos('LASER', line) ~= 0 then
- labeltype = laser
- else if pos('MATRIX', line) ~= 0 then
- labeltype = matrix
- else
- exit_msg("Invalid database file")
-
- spos = Pos('PAGESIZE', line)
-
- if spos ~= 0 then
- do
- line = substr(line, spos + 8)
- opageh = word(line, 2)
- opagev = word(line, 1)
- end
- else
- do
- opageh = 0
- opagev = 0
- end
-
-
- lcounter = 0
-
- do while ~eof(file)
-
- line = strip(readln(file))
-
- if line = '' | left(line, 2) = '\*' | left(line, 2) = '*/' then
- iterate
-
- lcounter = lcounter + 1
-
- parse var line code ';' name ';' .
-
- code = strip(code)
- name = strip(name)
- text = code || copies(" ", max(1,12 - length(code))) || name
-
- lines.lcounter.0 = line
- lines.lcounter.1 = text
-
- labels = labels||cr||text
-
- end
-
- labels = delstr(labels,1,1)
- label = ppm_SelectFromList("Select Label..", 40, 10, 0, labels)
- if label = '' then exit_msg()
-
- do i = 0 to lcounter - 1
-
- cline = lines.i.1
- if cline = label then leave
-
- end
-
- line = lines.i.0
-
- group = 0
-
- if ppm_GroupFirstBox() ~= 0 then
- do
- if ppm_Inform(2,"Would like like to tile the current group to create labels?", "No","Yes") then group = 1
- end
- else if ppm_BoxNum() ~= 0 then
- do
- if ppm_BoxPage() ~= 0 then
- if ppm_Inform(2,"Would like like to tile the current box to create labels?", "No","Yes") then group = 2
- end
-
- if labeltype = laser then
- do
- sline = compress(line)
- parse var sline pnum ';' type ';' lheight ';' lwid ';' cols ';' rows ';' topmarg ';' sidemarg ';' hpitch ';' vpitch ';' .
-
- if ~exists("rexx:GroupTile.pprx") then
- exit_msg("Unable to locate Genie named: rexx:GroupTile.pprx")
-
- npages = ppm_GetForm("How many pages will you need?", 8, "Pages:1")
- if npages = '' then exit_msg()
-
- if ~datatype(npages, n) then exit_msg("Invalid entry")
-
- newpage = ppm_CreatePage(ppm_CurrentPage() + 1,1,0,0,0)
-
- if opagev ~= 0 then
- call ppm_SetPageSize(newpage, opagev, opageh)
-
- call ppm_GotoPage(newpage)
-
- if group = 2 then
- do
- call ppm_NewGroup()
- call ppm_AddToGroup(ppm_BoxNum())
- call TileGroup(sidemarg,topmarg,lwid, lheight, cols, rows, hpitch, vpitch)
- end
- else if group = 1 then
- do
- call TileGroup(sidemarg,topmarg,lwid, lheight, cols, rows, hpitch, vpitch)
- end
- else
- do
- call ppm_NewGroup()
- box = ppm_CreateBox(sidemarg, topmarg, lwid, lheight, 0)
- call ppm_AddToGroup(box)
- call TileGroup(sidemarg,topmarg,lwid,lheight,cols,rows, hpitch, vpitch)
- end
-
- message = "Done"
-
- end
- else
- do
- sline = compress(line)
- parse var sline pnum ';' type ';' lheight ';' lwid ';' cols ';' cwidth ';' hpitch ';' vpitch ';' .
-
- npages = ppm_GetForm("How many Pages of Dot Matrix Labels?", 18, "Number of labels:"1)
- if npages = '' then exit_msg()
-
- if ~datatype(npages, n) then exit_msg("Invalid input")
-
- if vpitch < 1 then vpitch = 1
-
- hspace = hpitch - lwid
- lmarg = (cwidth - (cols * hpitch - hpitch + lwid)) / 2
- tmarg = (vpitch - lheight) / 2
-
- newpage = ppm_CreatePage(ppm_CurrentPage() + 1, 1, 0, 0, 0)
- call ppm_SetPageSize(newpage, cwidth, vpitch)
- call ppm_GotoPage(newpage)
-
- if group = 2 then
- do
- call ppm_NewGroup()
- call ppm_AddToGroup(ppm_BoxNum())
- call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
- end
- else if group = 1 then
- do
- call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
- end
- else
- do
- call ppm_NewGroup()
- box = ppm_CreateBox(lmarg, tmarg, lwid, lheight, 0)
- call ppm_AddToGroup(box)
- call TileGroup(lmarg,tmarg,lwid, lheight, cols, 1, hpitch, vpitch)
- call ppm_DeleteBox(box)
- end
-
- call ppm_SetDMEject(0)
- call ppm_SetDMPageSize(cwidth, vpitch)
-
- cwidth = ppm_ConvertUnits(1, units, cwidth)
- vpitch = ppm_ConvertUnits(1, units, vpitch)
-
- if units = 1 then unit = "inches"
- else if units = 2 then unit = "CM"
- else if units = 3 then unit = "Picas"
-
- message = "Done. The Dot Matrix Page Eject has been turned off and the output page size has been set to "cwidth" "unit" x "vpitch" "unit
-
- end
-
- npages = npages - 1
- cpage = ppm_CurrentPage()
-
- do npages
-
- call ppm_CopyPage(cpage, cpage + 1, 1)
- cpage = cpage + 1
-
- end
-
- exit_msg(message)
-
- exit_msg: procedure expose units
- do
- parse arg message
-
- if message ~= '' then call ppm_Inform(1,message,)
- call ppm_ClearStatus()
- call ppm_SetUnits(units)
- call ppm_AutoUpdate(1)
- exit
- end
-
- TileGroup: procedure expose newpage
- do
- parse arg sidemarg, topmarg, lwid, lheight, cols, rows, hpitch, vpitch
-
- i = 0
-
- box = ppm_GroupFirstBox()
-
- do while box ~= 0
-
- i = i + 1
- newbox.i = ppm_CloneBox(box, 0, 0)
-
- if ppm_TextOverFlow(box) then
- do
- call ppm_DeleteContents(newbox.i)
- call ppm_TextIntoBox(newbox.i, ppm_GetArticleText(box, 1))
- end
-
- call ppm_BoxChangePage(newbox.i, newpage)
- box = ppm_GroupNextBox(box)
-
- end
-
- call ppm_NewGroup()
-
- do x = 1 to i
- call ppm_AddToGroup(newbox.x)
- end
-
- grouprect = ppm_GetGroupRect()
- xscale = lwid / word(grouprect, 3) * 100
- yscale = lheight / word(grouprect, 4) * 100
- address command
- call GroupScale.pprx(xscale, yscale)
-
- xsp = hpitch - lwid
- ysp = vpitch - lheight
-
- call GroupTile.pprx(sidemarg, topmarg, rows, cols, xsp, ysp)
- return
- end
-